Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/forms/dbgrid1/form1.frm

Visual Basic Form | 1995-10-16 | 24.4 KB | 646 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   6090
   ClientLeft      =   3390
   ClientTop       =   1965
   ClientWidth     =   5580
   Height          =   6495
   Left            =   3330
   LinkTopic       =   "Form1"
   ScaleHeight     =   6090
   ScaleWidth      =   5580
   Top             =   1620
   Width           =   5700
   Begin VB.CommandButton cmdUnselectRows
      Caption         =   "Unselect Rows"
      Height          =   372
      Left            =   3600
      TabIndex        =   11
      Top             =   5400
      Width           =   1452
   End
   Begin VB.TextBox Text2
      Height          =   390
      Left            =   1635
      TabIndex        =   3
      Text            =   "0"
      Top             =   4350
      Width           =   480
   End
   Begin VB.TextBox Text1
      Height          =   390
      Left            =   720
      TabIndex        =   2
      Text            =   "0"
      Top             =   4350
      Width           =   480
   End
   Begin VB.CommandButton cmdSelectCols
      Caption         =   "Sel &Cols"
      Height          =   375
      Left            =   2400
      TabIndex        =   1
      Top             =   4320
      Width           =   1080
   End
   Begin VB.CommandButton cmdGetBookmark
      Caption         =   "Save Cur Row"
      Height          =   372
      Left            =   240
      TabIndex        =   9
      Top             =   4920
      Width           =   1452
   End
   Begin VB.CommandButton cmdSetBookmark
      Caption         =   "GoTo Saved Row"
      Height          =   372
      Left            =   240
      TabIndex        =   8
      Top             =   5400
      Width           =   1452
   End
   Begin VB.CommandButton cmdPhonyDCFirst
      Caption         =   "|<"
      Height          =   252
      Left            =   240
      TabIndex        =   7
      Top             =   240
      Width           =   252
   End
   Begin VB.CommandButton cmdPhonyDCPrevious
      Caption         =   "<"
      Height          =   252
      Left            =   480
      TabIndex        =   13
      Top             =   240
      Width           =   252
   End
   Begin VB.CommandButton cmdPhonyDCNext
      Caption         =   ">"
      Height          =   252
      Left            =   2280
      TabIndex        =   14
      Top             =   240
      Width           =   252
   End
   Begin VB.CommandButton cmdPhonyDCLast
      Caption         =   ">|"
      Height          =   252
      Left            =   2520
      TabIndex        =   15
      Top             =   240
      Width           =   252
   End
   Begin VB.CommandButton cmdDeleteCurrent
      Caption         =   "Delete Current"
      Height          =   372
      Left            =   1920
      TabIndex        =   16
      Top             =   4920
      Width           =   1452
   End
   Begin VB.CommandButton cmdSelectRows
      Caption         =   "Select Rows"
      Height          =   372
      Left            =   3600
      TabIndex        =   17
      Top             =   4920
      Width           =   1452
   End
   Begin VB.CommandButton cmdWildCard
      Caption         =   "Wild Card"
      Height          =   372
      Left            =   1920
      TabIndex        =   18
      Top             =   5400
      Width           =   1452
   End
   Begin VB.CommandButton cmdAddNew
      Caption         =   "Add New"
      Height          =   375
      Left            =   3840
      TabIndex        =   0
      Top             =   4320
      Width           =   1215
   End
   Begin VB.Shape Shape1
      Height          =   855
      Left            =   120
      Top             =   3960
      Width           =   3495
   End
   Begin VB.Label Label3
      Caption         =   "to:  "
      Height          =   285
      Left            =   1335
      TabIndex        =   6
      Top             =   4320
      Width           =   225
   End
   Begin VB.Label Label2
      Caption         =   "from:  "
      Height          =   240
      Left            =   300
      TabIndex        =   5
      Top             =   4350
      Width           =   330
   End
   Begin VB.Label Label4
      Caption         =   "Select Columns in code"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   400
         size            =   9.75
         underline       =   -1  'True
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   360
      TabIndex        =   4
      Top             =   3960
      Width           =   2175
   End
   Begin MSDBGrid.DBGrid DBGrid1
      Height          =   3015
      Left            =   120
      OleObjectBlob   =   "Form1.frx":0000
      TabIndex        =   12
      Top             =   720
      Width           =   5295
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Phony Data Control"
      Height          =   255
      Left            =   720
      TabIndex        =   10
      Top             =   240
      Width           =   1575
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
'==================================================================='
'The following text contains a sample for manipulating data in an
'Unbound grid using an array for data storage.
'==================================================================='
'Data storage variables.  Dimensions and a place to put the data
Dim MaxRow As Integer       ' number of rows in array
Dim MaxCol As Integer       ' number of columns in array
Dim dataval() As Variant    ' a variable array to store the data.
'Other global variables
Dim ToMe As Variant         ' a bookmark for Get/Set Bookmark tests
Private Sub Form_Activate()
loadedflag = 1
End Sub
Private Sub Form_Load()
    'Set up, allocate and fill the data array.  For this example
    'the data is manufactured for simplicity.  The user is queried
    'for the initial number of rows.
    'The number of columns is taken as the number of columns set
    'up in the property pages.  Get to the property pages by
    'right-clicking on the grid at design time.  Select "Edit" to
    'get to the layout editor.  Columns can be inserted,appended and
    'deleted from the layout editor.  You must set focus to another control on
    'to leave the layout editor.  You can tell the grid is in the layout
    'editor by the cursor that is visible in the grid.  Column properties
    'can be changed by selecting "Properties" from the pop-up menu.
    'Get the dimensions of the data storage array, dataval
    MaxRow = 10 'Val(InputBox("Enter number of starting rows"))
    MaxCol = DBGrid1.Columns.Count
    'If zero initial rows are requested, additional set is
    'unnecessary
    If MaxRow <= 0 Then Exit Sub
    'The data array, dataval, is allocated with the
    'columns as the first index.  Columns are first since
    'the column count is fixed, and the number of rows may
    'change.  This allows us to "ReDim Preserve" for added
    'and deleted rows.
    ReDim dataval(0 To MaxCol - 1, 0 To MaxRow - 1)
    Dim row, col As Integer
    For row = 0 To MaxRow - 1
       For col = 0 To MaxCol - 1
          dataval(col, row) = "(R" & row & ", C" & col & ")"
       Next col
    Next row
End Sub
'These routines demonstrate Unbound grid manipulations
'through VBA code.
Private Sub cmdAddNew_Click()
    'This button event positions the user to
    'the Grid AddNew row.
    If DBGrid1.AllowAddNew Then
        If MaxRow > 0 Then
            'position to the last row.  Moving twice causes
            'a pending AddNew to update, and then become the
            'last row for the second MoveLast
            cmdPhonyDCLast_Click   'defined below

            cmdPhonyDCLast_Click
        End If
        'position to the next grid row
        DBGrid1.col = 0
        DBGrid1.row = DBGrid1.row + 1
    End If
    DBGrid1.SetFocus
End Sub
Private Sub cmdGetBookmark_Click()
    'This button event obtains the bookmark for the
    'current row and stores it for later use by the
    '"Set Bookmark" button.
    ToMe = DBGrid1.bookMark
End Sub
Private Sub cmdSetBookmark_Click()
    'This button event moves to the row which was current
    'the last time the "Get Bookmark" button was pressed.
    DBGrid1.bookMark = ToMe
End Sub
Private Sub cmdDeleteCurrent_Click()
    'This button event deletes the current row
    On Error GoTo BadBkmk
    'the current row must be selected to delete it
    DBGrid1.SelBookmarks.Add DBGrid1.bookMark
    DBGrid1.SetFocus
    SendKeys "{DEL}"
    Exit Sub
BadBkmk:
    MsgBox "There are no rows to delete."
End Sub
Private Sub cmdWildCard_Click()
    'This button event allows the user to position
    'to any row within the grid by generating a bookmark
    'and positioning the grid.  This can only be done
    'because our VBA code as knowledge of the internal
    'meaning of the bookmark.
    '
    'Note that the VBA makeBookmark() function is used
    'to manufacture the bookmark.
    Dim result As Integer
    result = Val(InputBox("Enter row number"))
    DBGrid1.bookMark = makeBookmark(result)
End Sub
Private Sub cmdSelectCols_Click()
'select columns specified in textboxes
'workaround
    Dim hi As Integer
    Dim lo As Integer
    lo = Val(Text1.Text)
    hi = Val(Text2.Text)

    'workaround::needs to be reset
    DBGrid1.SelStartCol = 0
    'workaround::if columns with higher index numbers are previously_
    'selected, the selection will not take place
    If DBGrid1.SelEndCol > hi Then
        DBGrid1.SelEndCol = hi
    End If
    'workaround::notice Start is assigned the higher number_
    'and it is assigned twice
    DBGrid1.SelStartCol = hi
    DBGrid1.SelStartCol = hi
    DBGrid1.SelEndCol = lo
End Sub
Private Sub cmdSelectRows_Click()
    'This button event causes every other visible row to be
    'selected, starting with the first row.
    Dim rowbmk As Variant
    Dim rowcnt As Long
    Dim row As Long
    'position to the first row on the grid
    DBGrid1.bookMark = DBGrid1.FirstRow
    'get count of visible rows
    rowcnt = DBGrid1.VisibleRows

    'select every other row.  It is possible that we may request
    'an invalid bookmark (passed EOF, i.e. the AddNew line), so we
    'include some error processing to handle this.
    On Error GoTo LoopExit
    For row = 0 To rowcnt Step 2
        rowbmk = DBGrid1.GetBookmark(row)
        DBGrid1.SelBookmarks.Add rowbmk
    Next row
LoopExit:
    Exit Sub
End Sub
Private Sub cmdUnselectRows_Click()
    'This button event deselects all Selected Rows
    While DBGrid1.SelBookmarks.Count
        DBGrid1.SelBookmarks.Remove 0
    Wend
End Sub
'Utility Functions
Private Function isAddNew() As Boolean
    'This function determines if an AddNew is being processed
    'For an AddNew to be in operation, the grid must
    'be in a modified state.
    'If DBGrid1.DataChanged Then     'True DBGrid only
        'if there is currently no data, it must be AddNew
        If MaxRow = 0 Then
            isAddNew = True
            Exit Function
        End If

        'the modified row is an AddNew and not an update
        'if the current row bookmark and current row are
        'not indicating the same row.  This happens because
        'an AddNew does not change the current row (in the
        'database sense), but a different physical row of
        'the grid is being editted.

        Dim curindex, topindex As Integer
        curindex = GetArrayIndex(DBGrid1.bookMark, False)
        topindex = GetArrayIndex(DBGrid1.FirstRow, False)
        If (curindex - topindex) <> DBGrid1.row Then
            isAddNew = True
            Exit Function
        End If
    'End If
    isAddNew = False
End Function
'The following functions manage the data array
'addressing, both through indices and bookMarks
'and provide appropriate conversion from array
'indices to bookmarks and back again.
Private Function isInvalidIndex(ByVal rindex As Integer) As Boolean
    If rindex < 0 Or rindex >= MaxRow Then
        isInvalidIndex = True
    Else
        isInvalidIndex = False
    End If
End Function
Private Function makeBookmark(rindex As Integer) As Variant
    'It is important that bookmarks be generated in a
    'consistant manner throughout the code.  The importance
    'of this cannot be overstressed.
    '
    'The grid handles bookmarks as "blackbox" objects - i.e.
    'as objects for which the internal data has no meaning.
    'This means that "01" and " 1" and "1" are all considered
    'different, even though the interpretted numeric value is
    'the same.
    '
    'Therefore, care must be taken to avoid using different
    'means for generating bookmarks which refer to the same
    'row.  For example,
    '
    '              Format$(1) produces the string "1"
    '   while,     Str$(1) will generate " 1".
    '
    'These are clearly different in the blackbox sense and
    'so will be treated differently by the grid, even though
    'both strings are derived from the same numeric value.
    '
    'To avoid such difficulties, we use a single VBA function
    'to manage the creation of bookmarks, thus insuring
    'consistency.  If the method of generation must change
    'as the code evolves, we can simply change this function
    'and still guarrantee bookmark consistency.
    makeBookmark = Str(rindex)
End Function
Private Function GetArrayIndex(bookMark As Variant, _
              ReadPriorRows As Boolean) As Integer
    If IsNull(bookMark) Then

        'A Null bookmark indicates BOF or EOF, depending upon
        'direction.  If the grid is requesting ReadPriorRows,
        'then Null refers to EOF.  If ReadPriorRows is not
        'True valued, then Null represents BOF
        If ReadPriorRows Then
            GetArrayIndex = MaxRow  'EOF of the array
        Else
            GetArrayIndex = -1      'BOF of the array
        End If
        Exit Function
    Else

        'Determine the array index from the bookmark.  This
        'function must invert the bookmark construction process
        'of the makeBookmark() function.  Again, this is handled
        'in a single function to assure consistency and allow
        'easy methodology changes as our code evolves.
        Dim bk As Integer
        bk = Val(bookMark)
        If bk >= 0 And bk < MaxRow Then
            GetArrayIndex = bk
            Exit Function
        End If
    End If
    'We should never get here.  Return an index that is "way bad"
    'such that minor increments of the value do not produce a
    'valid index.  This simplifies code elsewhere.
    GetArrayIndex = -2000
End Function
'Set up some buttons to emulate a Data Control
'Special bookmarks can be generated from internal
'knowledge of the data storage method (an array index)
'When possible, it is best obtain bookmarks from the
'grid rather than manufacturing them.  This insures
'consistency of bookmarks better than any other method.
'In some cases, special bookmarks may require local
'generation - e.g. First and Last.  In these cases,
'note that our VBA makeBookmark() function is used to
'insure bookmark consistency
Private Sub cmdPhonyDCFirst_Click()
    DBGrid1.bookMark = makeBookmark(0)
End Sub
Private Sub cmdPhonyDCLast_Click()
    DBGrid1.bookMark = makeBookmark(MaxRow - 1)
End Sub
Private Sub cmdPhonyDCNext_Click()
    Dim rindex As Integer
    'make sure the next row is valid
    rindex = GetArrayIndex(DBGrid1.bookMark, False) + 1
    If isInvalidIndex(rindex) Then
        DBGrid1.SetFocus
    Else
        DBGrid1.bookMark = DBGrid1.GetBookmark(1)
    End If
End Sub
Private Sub cmdPhonyDCPrevious_Click()
    Dim rindex As Integer
    'make sure the previous row is valid
    rindex = GetArrayIndex(DBGrid1.bookMark, False) - 1
    If isInvalidIndex(rindex) Then
        DBGrid1.SetFocus
    Else
        DBGrid1.bookMark = DBGrid1.GetBookmark(-1)
    End If
End Sub
'The Unbound Events
'The RowBuffer object, passed to the grid events is an OLE
'object.  Though efficient, resolution of references to
'RowBuffer members requires some overhead.  Thus, we use
'local variable whenever possible to store information
'which does not change for the duration of the event,
'especially for situations involving loops.
'Thus, RowBuf.RowCount and RowBuf.ColumnCount values are
'cached in local variables for the duration of the event.
Private Sub DBGrid1_UnboundAddData(ByVal RowBuf As RowBuffer, _
                NewRowBookmark As Variant)
    'reallocate the array to include an extra row
    ReDim Preserve dataval(0 To MaxCol - 1, 0 To MaxRow)
    'Get the column limit of the columns to be processed.
    Dim collimit As Integer     'limit of RowBuffer columns
    collimit = RowBuf.ColumnCount - 1
    'check each column for an updated value.  For Add and
    'Write operations, the RowBuffer object is a "sparse"
    'storage object, containing Null values for row/column
    'combinations which have not been modified and therefore
    'should not be used as data.
    Dim col As Integer          'column indicator for RowBuffer
    For col = 0 To collimit
        If Not IsNull(RowBuf.Value(0, col)) Then
            dataval(col, MaxRow) = RowBuf.Value(0, col)
        Else
            'Unbound mode does not have a database to fill in
            'the default values.  We can use what is stored in
            'the column default, or we stick in anything else we
            'wanted, including something that depends on the other
            'column or row data.  But in this case, we'll just
            'use the column default.
            dataval(col, MaxRow) = DBGrid1.Columns(col).DefaultValue
        End If
    Next col
    'set the bookmark for the added row
    NewRowBookmark = makeBookmark(MaxRow)
    'increment the row count
    MaxRow = MaxRow + 1
End Sub
Private Sub DBGrid1_UnboundDeleteRow(bookMark As Variant)
    'if there are no rows to delete, set the bookmark to Null
    'to indicate an error and return immediately.
    If MaxRow = 0 Then
        bookMark = Null
        Exit Sub
    End If
    'the grid refreshes all of its bookmarks after the deletion
    'occurs.  Therefore, we can just remove the element from
    'the data array.  However, if VBA code is storing bookmarks
    'for later use, another approach should be taken such that
    'deleted "rows" become invalid
    'get the array index of the row after the row to be deleted
    Dim rindex As Integer       'dataval array index for the "row"
    rindex = GetArrayIndex(bookMark, False) + 1
    'move the data after the delete row up one row, thus
    'eliminating the deleted row from the data array
    Dim col As Integer          'column of data array
    While Not isInvalidIndex(rindex)
        For col = 0 To MaxCol - 1
            dataval(col, rindex - 1) = dataval(col, rindex)
        Next col
        rindex = rindex + 1
    Wend
    'decrement the row count, and reallocate the array preserving
    'the existing data.  If the last row is being deleted,
    'it is not necessary to change the allocation.
    MaxRow = MaxRow - 1
    If MaxRow <> 0 Then
        ReDim Preserve dataval(0 To MaxCol - 1, 0 To MaxRow - 1)
    End If
End Sub
Private Sub DBGrid1_UnboundReadData(ByVal RowBuf As RowBuffer, StartLocation As Variant, ByVal ReadPriorRows As Boolean)
    'if there is no data, then flag no rows available and return
    If MaxRow = 0 Then
        RowBuf.RowCount = 0
        Exit Sub
    End If
    Dim rowsFetched As Integer      'track count of RowBuf rows set
    rowsFetched = 0     'track the number of rows we fetch
    'Unfortunately, the VB DBGrid help is misleading, even though
    'the example is clear.
    '  ReadPriorRows = True means the RowBuffer wants the rows
    '                  BEFORE the StartLocation.
    'Therefore, we must move backward in our array when filling
    'the buffer.  We always move forward in the RowBuffer itself.
    Dim incr As Integer
    If ReadPriorRows Then
        incr = -1       'move backward in array
    Else
        incr = 1        'move forward in array
    End If
    'Find the array index of the starting row.
    Dim rindex As Integer           'the array (row) index for data
    rindex = GetArrayIndex(StartLocation, ReadPriorRows)
    'The first row to receive a value, is the first increment passed
    'the starting row
    rindex = rindex + incr
    'use rowlimit and collimit as the number of rows and columns
    'requested by the row buffer
    Dim rowlimit, collimit As Integer   'row and column limits for loop
    rowlimit = RowBuf.RowCount - 1
    collimit = RowBuf.ColumnCount - 1
    Dim row, col As Integer         'row and column counters for RowBuf
    For row = 0 To rowlimit

        'check to see if we are out of "rows" in the array
        If isInvalidIndex(rindex) Then Exit For

        'fill in the RowBuffer columns
        For col = 0 To collimit
            'do not allow empty variants to be put into rowbuffer
            If VarType(dataval(col, rindex)) = 0 Then
                dataval(col, rindex) = Null
            End If

            RowBuf.Value(row, col) = dataval(col, rindex)
        Next col
        'derive a bookmark that makes it easy to find the array rindex
        'makeBookmark creates the bookmark, GetArrayIndex interprets it.
        RowBuf.bookMark(row) = makeBookmark(rindex)
        rindex = rindex + incr    'locate next "row" in array by rindex
        rowsFetched = rowsFetched + 1       'track rows fetched
    Next row
    'Tell the RowBuffer how many rows were fetched
    RowBuf.RowCount = rowsFetched
    Exit Sub
End Sub
Private Sub DBGrid1_UnboundWriteData(ByVal RowBuf As RowBuffer, WriteLocation As Variant)
    'if there is no data avaialable, there cannot be an update.
    If MaxRow = 0 Then
        RowBuffer.RowCount = 0  'indicate update failure
        Exit Sub
    End If
    'get the array index of the desired column
    Dim rindex As Integer       'dataval array index for the row
    rindex = GetArrayIndex(WriteLocation, False)
    If Not isInvalidIndex(rindex) Then
        'get the maximum column to process
        Dim collimit As Integer     'limit of RowBuffer columns
        collimit = RowBuf.ColumnCount - 1
        'check each column for an updated value.  For Add and
        'Write operations, the RowBuffer object is a "sparse"
        'storage object, containing Null values for row/column
        'combinations which have not been modified and therefore
        'should not be used as data.
        Dim col As Integer          'column indicator for RowBuffer
        For col = 0 To collimit
            If Not IsNull(RowBuf.Value(0, col)) Then
                dataval(col, rindex) = RowBuf.Value(0, col)
                colsUpdated = colsUpdated + 1
            End If
        Next col
    End If
End Sub
'Other Grid events
Private Sub DBGrid1_KeyPress(KeyAscii As Integer)
    'This KeyPress event traps the return key, and if an
    'AddNew is in progress, then converts the Return into
    'an Update of the Current AddNew, and starts another
    'AddNew.
'** this is not functioning properly yet
'** the grid does not move to the AddNew row as intended
'** someday, when there is time ...  <g>
    If KeyAscii = 13 Then
        'if current is AddNew
        If isAddNew() Then      'isAddNew given above
            KeyAscii = 0
            cmdAddNew_Click 'trigger another AddNew
        End If
    End If
End Sub